home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / c01lab4.zip / LRMRDR / LRM_CODE.ZIP / DAF.A < prev    next >
Text File  |  1992-05-29  |  9KB  |  269 lines
  1. -- COPYRIGHT NOTICE
  2. -- Ada LRM Reader - Interactive Presentation of the Ada LRM
  3. -- Copyright (C) 1992    Richard Conn
  4. --
  5. -- This program is free software; you can redistribute it
  6. -- and/or modify it under the terms of the GNU General Public
  7. -- License Version 1 as published by the Free Software
  8. -- Foundation.
  9. --
  10. -- This program is distributed in the hope that it will be
  11. -- useful, but WITHOUT ANY WARRANTY; without even the implied
  12. -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  13. -- PURPOSE.  See the GNU General Public License for more
  14. -- details.  You should have received a copy of the GNU General
  15. -- Public License along with this program; if not, write to the
  16. -- Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
  17. -- 02139, USA.  See the ABOUT screens for further information,
  18. -- including information on how to contact the author.
  19. with SYSDEP;
  20. package DAF_Handler is
  21. -- Handler for Direct Access Files (DAFs)
  22.  
  23.   -- Types of LINEs (records) in DAFs
  24.   type LINE_TYPE is (NORMAL, SECTION, UNUSED);
  25.  
  26.   -- The LINE is the record of a DAF
  27.   type LINE is record
  28.     Str      : STRING (1..SYSDEP.Screen_String_Length);
  29.     Str_Last : NATURAL := 0; -- index of last char in Str
  30.     Kind     : LINE_TYPE := NORMAL;
  31.   end record;
  32.  
  33.   subtype LINE_NUMBER is NATURAL range 1..NATURAL'LAST;
  34.  
  35.   subtype DAF_ID is NATURAL range 0..SYSDEP.Citation_Stack_Depth;
  36.  
  37. -- Exceptions
  38.   DAF_CREATION_ERROR : exception;
  39.   FILE_NOT_FOUND     : exception;
  40.   NO_DAF_OPEN        : exception;
  41.   READ_ERROR         : exception;
  42.   WRITE_ERROR        : exception;
  43.   STACK_OVERFLOW     : exception;
  44.   UNEXPECTED_ERROR   : exception;
  45.  
  46. -- Subprograms to create a DAF file
  47.   procedure Create (File_Name : in STRING);
  48.   -- Create a DAF file
  49.  
  50.   procedure Write (Item : in STRING);
  51.   -- Write a string to a DAF file
  52.  
  53.   procedure Close_Create;
  54.   -- Close a DAF file
  55.  
  56. -- Subprograms to read DAF files
  57.   function Open (File_Name : in STRING) return DAF_ID;
  58.   -- Open an existing DAF file
  59.  
  60.   function Is_Open (ID : in DAF_ID) return BOOLEAN;
  61.   -- Determine if the DAF file is currently open
  62.  
  63.   function Is_End_of_File (ID : in DAF_ID) return BOOLEAN;
  64.   -- Determine if the end of a DAF file has been reached
  65.  
  66.   function Read (ID   : in DAF_ID;
  67.                  Lnum : in LINE_NUMBER) return LINE;
  68.   -- Read a specified line from a DAF file
  69.  
  70.   function Read_Next (ID : in DAF_ID) return LINE;
  71.   -- Read the next line from a DAF file
  72.  
  73.   procedure Close (ID : in DAF_ID);
  74.   -- Close a DAF file
  75.  
  76. end DAF_Handler;
  77.  
  78. with Direct_IO;
  79. package body DAF_Handler is
  80.  
  81.   -- I/O Subsystem for DAF Files
  82.   package DAF_IO is new Direct_IO (LINE);
  83.  
  84.   -- Flag to mark a file ID as available or not available
  85.   type USE_FLAG is (UNAVAILABLE, AVAILABLE);
  86.  
  87.   -- Class of Stack of file IDs
  88.   type FILE_ID_STACK  is array (1..DAF_ID'LAST) of DAF_IO.FILE_TYPE;
  89.  
  90.   -- Class of Stack of use flags
  91.   type FILE_USE_STACK is array (1..DAF_ID'LAST) of USE_FLAG;
  92.  
  93.   -- Actual stacks
  94.   Stack            : FILE_ID_STACK;
  95.   Stack_Use        : FILE_USE_STACK := (others => AVAILABLE);
  96.  
  97.   -- File_Type used for output DAF
  98.   Create_File_ID   : DAF_IO.FILE_TYPE;
  99.  
  100. -- Conversion function between STRING and LINE
  101.   -------------------------------------------------------------------------
  102.   function Convert (Item : in STRING;
  103.                     Kind : in LINE_TYPE := NORMAL) return LINE is
  104.   -- Return the indicated Item as a LINE
  105.     Result : LINE;
  106.   begin -- Convert
  107.     Result.Str_Last                := Item'LENGTH;
  108.     Result.Str(1..Result.Str_Last) := Item;
  109.     Result.Kind                    := Kind;
  110.     return Result;
  111.   end Convert;
  112.  
  113. -- Subprograms to create a DAF file
  114.   -------------------------------------------------------------------------
  115.   procedure Create (File_Name : in STRING) is
  116.   -- Create a DAF file
  117.   begin -- Create
  118.     DAF_IO.Create (Create_File_ID, DAF_IO.OUT_FILE, File_Name);
  119.   exception -- Create
  120.     when others => raise DAF_CREATION_ERROR;
  121.   end Create;
  122.  
  123.   -------------------------------------------------------------------------
  124.   procedure Write (Item : in STRING) is
  125.   -- Write a string to a DAF file
  126.  
  127.     procedure Write_Line (Line      : in STRING;
  128.                           Line_Kind : LINE_TYPE) is
  129.     -- Write a line, creating a continuation line if necessary
  130.     begin -- Write_Line
  131.       if Line'LENGTH > SYSDEP.Screen_Width then
  132.         DAF_IO.Write (Create_File_ID,
  133.                       Convert ("  " &
  134.                                Line(Line'FIRST ..
  135.                                     Line'FIRST-1+SYSDEP.Screen_Width),
  136.                                Line_Kind));
  137.         DAF_IO.Write (Create_File_ID,
  138.                       Convert ("| " &
  139.                                Line(Line'FIRST+SYSDEP.Screen_Width..
  140.                                     Line'LAST),
  141.                                Line_Kind));
  142.       else
  143.         DAF_IO.Write (Create_File_ID,
  144.                       Convert ("  " & Line, Line_Kind));
  145.       end if;
  146.     end Write_Line;
  147.  
  148.   begin -- Write
  149.     if Item'LENGTH > 2 and then Item(Item'FIRST..Item'FIRST+1) = "> " then
  150.       Write_Line (Item(Item'FIRST+2..Item'LAST), DAF_Handler.SECTION);
  151.         -- section line
  152.     else
  153.       Write_Line (Item, DAF_Handler.NORMAL);
  154.         -- normal line
  155.     end if;
  156.   exception -- Write
  157.     when others => raise WRITE_ERROR;
  158.   end Write;
  159.  
  160.   -------------------------------------------------------------------------
  161.   procedure Close_Create is
  162.   -- Close a DAF file
  163.   begin -- Close_Create
  164.     DAF_IO.Close (Create_File_ID);
  165.   exception -- Close_Create
  166.     when others => raise UNEXPECTED_ERROR;
  167.   end Close_Create;
  168.  
  169. -- Subprograms to read DAF files
  170.   -------------------------------------------------------------------------
  171.   function Open (File_Name : in STRING) return DAF_ID is
  172.   --Open an existing DAF file
  173.     Available_ID : DAF_ID := 0;
  174.   begin -- Open
  175.  
  176.     -- Locate an available DAF_ID
  177.     for I in Stack_Use'RANGE loop
  178.       if Stack_Use(I) = AVAILABLE then
  179.         Available_ID := I;
  180.         Stack_Use(I) := UNAVAILABLE;
  181.         exit;
  182.       end if;
  183.     end loop;
  184.  
  185.     -- Abort if no DAF_ID is available
  186.     if Available_ID = 0 then
  187.       raise STACK_OVERFLOW;
  188.     end if;
  189.  
  190.     -- Open file
  191.     DAF_IO.Open (Stack(Available_ID), DAF_IO.IN_FILE, File_Name);
  192.     return Available_ID;
  193.  
  194.   exception -- Open
  195.     when STACK_OVERFLOW => raise;
  196.     when others         => raise FILE_NOT_FOUND;
  197.   end Open;
  198.  
  199.   -------------------------------------------------------------------------
  200.   function Is_Open (ID : in DAF_ID) return BOOLEAN is
  201.   -- Determine if the DAF file is currently open
  202.   begin -- Is_Open
  203.     if ID = 0 then
  204.       raise NO_DAF_OPEN;
  205.     end if;
  206.     return DAF_IO.IS_OPEN (Stack(ID));
  207.   exception -- Is_Open
  208.     when NO_DAF_OPEN => raise;
  209.     when others      => raise UNEXPECTED_ERROR;
  210.   end Is_Open;
  211.  
  212.   -------------------------------------------------------------------------
  213.   function Is_End_of_File (ID : in DAF_ID) return BOOLEAN is
  214.   -- Determine if the end of a DAF file has been reached
  215.   begin -- Is_End_of_File
  216.     if ID = 0 then
  217.       raise NO_DAF_OPEN;
  218.     end if;
  219.     return DAF_IO.END_OF_FILE (Stack(ID));
  220.   exception -- Is_End_of_File
  221.     when NO_DAF_OPEN => raise;
  222.     when others      => raise UNEXPECTED_ERROR;
  223.   end Is_End_of_File;
  224.  
  225.   -------------------------------------------------------------------------
  226.   function Read (ID   : in DAF_ID;
  227.                  Lnum : in LINE_NUMBER) return LINE is
  228.   -- Read a specified line from a DAF file
  229.     Outline : LINE;
  230.   begin -- Read
  231.     if ID = 0 then
  232.       raise NO_DAF_OPEN;
  233.     end if;
  234.     DAF_IO.Read (Stack(ID), Outline, DAF_IO.POSITIVE_COUNT(Lnum));
  235.     return Outline;
  236.   exception -- Read
  237.     when NO_DAF_OPEN => raise;
  238.     when others      => raise READ_ERROR;
  239.   end Read;
  240.  
  241.   -------------------------------------------------------------------------
  242.   function Read_Next (ID : in DAF_ID) return LINE is
  243.   -- Read the next line from a DAF file
  244.     Outline : LINE;
  245.   begin -- Read_Next
  246.     if ID = 0 then
  247.